home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Demos / server.stk < prev    next >
Encoding:
Text File  |  1996-07-23  |  1.6 KB  |  45 lines
  1. #!/usr/local/bin/stk -f
  2. ;;;; s e r v e r  . s t k        -- A simple sever
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;; This software is a derivative work of other copyrighted softwares; the
  15. ;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
  16. ;;;;
  17. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  18. ;;;;    Creation date:  4-Feb-1995 18:17
  19. ;;;; Last file update: 12-Feb-1995 11:57
  20.  
  21. (define s (make-server-socket))
  22.  
  23. (dynamic-wind 
  24.  ;; Init: Launch an xterm with telnet running on the s listening port and connect
  25.  (lambda ()
  26.    (run-process "xterm" "-e" "telnet" "localhost" 
  27.         (number->string (socket-port-number s)))
  28.    (socket-accept-connection s)
  29.    (format (socket-output s) "\nWelcome on the socket REPL.\n\n> ")
  30.    (flush (socket-output s)))
  31.  
  32.  ;; Action: A toplevel like loop
  33.  (lambda ()
  34.    (let loop ()
  35.      (format (socket-output s) "; Result: ~s\n> " (eval (read (socket-input s))))
  36.      (flush (socket-output s))
  37.      (loop)))
  38.  
  39.  ;; Termination: We go here when 
  40.  ;;     a) an error occurs 
  41.  ;;    b) connection is closed
  42.  (lambda ()
  43.    (format #t "Shutdown ......\n")
  44.    (socket-shutdown s)))
  45.